00100	;Floppy disk directory routines.
00200	.INSERT ASMBL.FAI[CMS,LCS]
00300	.INSERT SYSDEF.FAI[CMS,LCS]
00400	
00500	   ZERO ← 274	;Fail offset
00600	
00700	   LOC ZERO+21
00800	CHR:	0	;Shifter temp. reg.
00900		0	;CUR
01000		0
01100	SHFLOC:	0	;Shift lock bit
01200	STOP:	JMP	STOP	;Go nowhere fast.
01300	FLAD:	0	;Disk buffer pointer
01400		0
01500	XU:	0	;Exec mode
01600	WFOPEN:	0	;Write file open flag
01700	OSEC:	0
01800	FLEN:	0
01900	UFLG:	0	;Program interrupt enable flag.
02000	MFLG:	0	;Modem / SI/O flag.
02100	
02200	   LOC ZERO+40
02300	FBLK:	0	;File block
02400	FNAM:	BLOCK 11	;9 Chr file name.
02500	FTRK:	0	;Disk track number
02600	FSEC:	0	;Disk sector number
02700	NSEC:	0	;Number of sectors
02800	
02900	   LOC ZERO+60
03000	DBUF:	0	;Directory buffer
03100	SCNT:	0	;Number of sectors
03200	FCNT:	0	;Number of files
03300	FFDIR:	0	;First free directory block
03400	FFTRK:	0	;First free track
03500	FFSEC:	0	;First free sector
     

00100	   LOC ZERO+100
00200	PCHR:	CMPI	12	;<lf>
00300		BEQ	LF
00400		CMPI	14	;<home> Key on S720 keyboard.
00500		BNE	CKCR
00600	LF:	CLC
00700		LDAZ	CUR
00800		ADCI	100	;Next line
00900		STAZ	CUR
01000		BCC	CLIN
01100		INCZ	23	;CUR+1
01200		LDAZ	23	;CUR+1
01300		CMPI	210	;End of DPY mem.
01400		BNE	CLIN
01500		LDAI	200
01600		STAZ	23	;CUR+1
01700	CLIN:	LDYI	77
01800		LDAI	40
01900	CLOOP:	STAIY	CUR	;Clear line
02000		DEY
02100		BPL	CLOOP
02200		BMI	CJUMP	;Update cursor
02300	
02400	CKCR:	CMPI	15	;<cr>
02500		BNE	CKBS
02600	CR:	LDAZ	CUR
02700		ANDI	300
02800		STAZ	CUR
02900	CJUMP:	JMP	UPCUR	;Update cursor
03000	
03100	CKBS:	CMPI	10	;<BS>
03200		BNE	JPIT
03300		JMP	BS
03400	JPIT:	JMP	PIT	;Print it
     

00100	   LOC ZERO+200
00200	FBUF:		;Disk buffer
00300	TERM:	PLA	;Fix stack
00400		PLA
00500		PLA
00600		LDAI	200	;Setup program interrupt enable
00700		STAZ	UFLG
00800		ASLA	;Clear A
00900		STAZ	XU	;Reset exec.
01000		CLI	;Enable interrutps
01100	
01200	ICHR:	JSR	PCHR	;Print a null and then chrs.
01300	TTYIN:	BITZ	UFLG	;Check if program enabled.
01400		BPL	STOP
01500	
01600		LDA	ACIAC	;Read ACIA status.
01700		LSRA	;Get reciver full bit.
01800		BCC	TTYIN	;Wait for chr.
01900		LDA	ACIAD	;Get byte from UART
02000	
02100		BEQ	TTYIN	;Flush nulls.
02200		BNE	ICHR	;Print it.
02300	
02400	;TTY mode interrupt routine.
02500	TTYO:	CMPI	14	;<home> to <lf>
02600		BNE	CKCLR
02700		LDAI	12
02800	CKCLR:	CMPI	152	;<Clear>
02900		BNE	CKSB
03000		LDAI	3	;<CALL>
03100	CKSB:	CMPI	150	;<Send block>
03200		BNE	NOSLOC
03300		LDAZ	SHFLOC
03400		EORI	40	;Complement shift lock bit.
03500		STAZ	SHFLOC
03600		JMP	RTRN
03700	
03800	NOSLOC:	CMPI	142	;<Type>
03900		BNE	NOMCOM
04000		LDAZ	MFLG
04100		EORI	377	;Complement modem flag
04200		STAZ	MFLG
04300		JMP	RTRN
04400	
04500	NOMCOM:	STAZ	CHR	;Save it for shifter.
04600		ANDI	177	;Flush <Repeat> bit.
04700	
04800		CMPI	"A"	;Not less than A
04900		BCC	NOSHFT
05000		CMPI	"["	;Less than Z
05100		BCS	NOSHFT
05200	
05300		LDAZ	SHFLOC	;Get shift lock bit.
05400		BITZ	CHR	;Check for <Repeat> bit.
05500		BPL	SHFT
05600		EORI	40	;Complement shift.
05700	SHFT:	EORZ	CHR	;Shift chr.
05800		STAZ	CHR
05900	
06000	NOSHFT:	LDXZ	CHR
06100		BITZ	MFLG	;Modem SI/O flag.
06200		BPL	SHOIT
06300		CPXI	10	;<bspace>
06400		BNE	CKDTAB
06500		LDXI	177
06600	CKDTAB:	CPXI	13	;<dtab>
06700		BNE	TRANW
06800		LDXI	33	;<alt>
06900	TRANW:	LDA	ACIAC	;Read SI/O status.
07000		ANDI	2	;Wait until transmiter empty.
07100		BEQ	TRANW
07200		STX	ACIAD	;Transmit it
07300		JMP	RTRN	;Return from interrupt.
07400	
07500	SHOIT:	TXA
07600		JMP	ECHO	;Print it and return.
     

00100	   LOC ZERO+1000
00200	   RLOC ← 2	;High byte of origin address
00300	
00400	IRQV:	STAZ	3	;IRQ vector. Save A
00500		JMP	IPOLL
00600	
00700	NMIV:	PLA		;Non maskable interupt vector
00800		PLA	;Flush stack
00900		PLA
01000	
01100		LDXI	0	;For ENDSK
01200		JSR	ENDSK	;Reset disk, timer. Read status
01300		JMP	RERR	;Return with error
01400	
01500	IPOLL:	BIT	KBC	;Check if keyboard
01600		BMI	RKEY
01700		JMP	177432	;Jump to DDT
01800	
01900	RKEY:	PHA	;Save registers
02000		TYA
02100		PHA
02200		TXA
02300		PHA
02400	
02500		LDA	KBD	;Read keyboard
02600	
02700		CMPI	352	;<Clear>
02800		BNE	CKX
02900		STAZ	XU	;Set exec.
03000		JSR	PCHR	;Echo it.
03100	
03200		JSR	CR	;<cr>
03300		LDAI	12	;<lf>
03400		STAZ	UFLG	;Disable program interrupts.
03500	ECHO:	JSR	PCHR
03600		JMP	RTRN
03700	
03800	CKX:	BITZ	XU	;Check mode
03900		BMI	EXEC
04000		BITZ	UFLG	;Check if program int.
04100		BPL	ECHO
04200		JMP	TTYO
     

00100	EXEC:	CMPI	15	;<cr>
00200		BNE	ECHO
00300	
00400		JSR	PCHR	;Echo it
00500		LDYI	12	;Number of chrs+1 in FNAM
00600	NLOOP:	LDAIY	CUR	;Save file name in FNAM
00700		STAY	37	;FBLK-1
00800		DEY
00900		BNE	NLOOP
01000	
01100		CMPI	40	;Check for <space>
01200		BEQ	GCMD
01300		LDAI	77	;"α
01400		BNE	NOSPC
01500	
01600	GCMD:	LDAIY	CUR	;Get command
01700	
01800	NOSPC:	PHA
01900		LDAI	FMARK	;Setup file mark
02000		STAZ	FBLK
02100		JSR	LF	;Print <lf>.
02200		PLA
     

00100		CMPI	"T"	;Type file
00200		BNE	CKWRT
00300	
00400		JSR	OPIN
00500		BNE	XERR
00600		JSR	DPYDSK	;Setup disk load address
00700	RIT:	JSR	READ	;Read the file
00800		JMP	ECK	;Check for error
00900	
01000	CKWRT:	CMPI	"W"	;Save screen
01100		BNE	CKLOAD
01200	
01300		LDAI	20	;File length in sectors.
01400		JSR	ENTR
01500		BNE	XERR
01600		JSR	DPYDSK	;Setup disk write address
01700		BNE	WIT	;Write it
01800	
01900	CKLOAD:	CMPI	"L"	;Load file
02000		BNE	CKRUN
02100	
02200		JSR	OPIN
02300		BNE	XERR
02400		JSR	ADRSET	;Setup disk read address
02500		BNE	RIT	;Jump and load it
02600	
02700	CKRUN:	CMPI	"R"	;Run program
02800		BNE	CKUN
02900	
03000		JSR	OPIN
03100		BNE	XERR
03200		JSR	ADRSET	;Setup disk read address
03300		JSR	READ	;Load file
03400		BNE	XERR	;Check for error
03500	
03600	   UMEM ← FBUF	;Until more memory
03700		JMP	UMEM	;Jump to program
03800	
03900	CKUN:	CMPI	"U"	;Unload
04000		BNE	XERR	;Exec. error
04100	
04200		LDAI	1	;File length in sectors.
04300		JSR	ENTR
04400		BNE	XERR
04500		JSR	DPYDSK	;Setup disk write address
04600		JSR	XONE	;Until more memory
04700	WIT:	JSR	WRITE	;Write it
04800		BNE	XERR
04900		JSR	CLOZE
05000	ECK:	BEQ	XOFF	;Jump if no error
05100	XERR:	LDAI	77	;Print 
05200		JSR	PCHR
05300	
05400	XOFF:	LDAI	0
05500		STAZ	XU	;Reset XU
05600	
05700	RTRN:	PLA
05800		TAX
05900		PLA
06000		TAY
06100		PLA
06200		RTI	;Return
     

00100	DPYDSK:	LDAI	200	;Setup disk buffer address
00200		STAZ	31	;FLAD+1
00300		ASLA	;Clear A
00400		STAZ	FLAD
00500		LDXI	20	;16 sectors.
00600	XSET:	STXZ	NSEC
00700		RTS
00800	
00900	ADRSET:	LDAI	200	;Setup disk buffer address
01000		STAZ	FLAD
01100		ASLA	;Clear A
01200		STAZ	31	;FLAD+1
01300	XONE:	LDXI	1	;X=1 For one sector
01400		BNE	XSET
     

00100	   DMARK ← 74	;Directory mark
00200	   FMARK ← 72	;File mark
00300	
00400	LOKUP:	JSR	FWAI	;Check if disk busy
00500		LDAI	364	;Restore track 0
00600		STA	FDSKC
00700		JSR	FWAI
00800	
00900		LDAI	375	;Second sector
01000		STA	FDSKS
01100		JSR	RBUF	;Load one sector into FBUF
01200		BNE	NOHED	;Check for read error
01300	
01400		LDAZ	FBUF	;Check for directory mark
01500		CMPI	DMARK
01600		BNE	NOHED
01700	
01800		LDXI	17
01900	GDIR:	LDAZX	FBUF	;Save first 16 bytes
02000		STAZX	DBUF
02100		DEX
02200		BPL	GDIR
     

00100		LDAZ	SCNT	;Number of sectors in directory
00200		STAZ	NSEC	;Wipe out NSEC
00300		LDYI	20	;BLK Length
00400	
00500	CKDIR:	LDXI	0
00600	
00700	CKNAM:	LDAY	FBUF
00800		CMPZX	FBLK
00900		BNE	NXTF
01000	
01100		INY
01200		INX
01300		CPXI	12
01400		BNE	CKNAM
01500	;File names match so..
01600		LDAY	FBUF	;Get file track number.
01700		STAZ	FTRK
01800		LDAY	201	;FBUF+1
01900		STAZ	FSEC	;File sector number.
02000		LDAY	202	;FBUF+2
02100		STAZ	NSEC	;File length.
02200		TAX
02300		LDAI	0	;File found.
02400		RTS
02500	
02600	NXTF:	TYA
02700		ORAI	17
02800		TAY
02900		INY		;Get next dir entry
03000		BPL	CKDIR	;More in buffer
03100	
03200		DECZ	NSEC	;More sectors
03300		BEQ	FNF
03400	
03500		DEC	FDSKS	;Next sector
03600		JSR	RBUF
03700		BNE	NOHED
03800		LDYI	0
03900		BEQ	CKDIR
04000	
04100	FNF:	LDAI	200	;Not in directory
04200	NOHED:	RTS
     

00100	OPIN:	JSR	LOKUP	;Lookup file FNAM
00200		BNE	RX	;File not found
00300	
00400	SEEK:	LDAZ	FTRK	;Get track and sector
00500		STA	FDSKD
00600		LDAZ	FSEC
00700		STA	FDSKS
00800		LDAI	340	;Seek and verify command
00900		STA	FDSKC
01000	
01100		JSR	FWAI	;Wait and read status
01200		EORI	177
01300		ANDI	354	;Flush index bit, etc.
01400	
01500	RX:	RTS
01600	
01700	;Wait until not busy.
01800	FWAI:	LDA	FDSKC	;Read status
01900		LSRA
02000		BCC	FWAI	;Check if busy
02100		RTS
02200	
02300	SETTO:	JSR	FWAI	;Wait until not busy.
02400	SETT:	LDYI	2	;Setup time out interupt vector
02500		LDAI	PLA
02600	ISET:	STAY	NMIV
02700		DEY
02800		BPL	ISET
02900	
03000		LDAI	377	;Init timer
03100		STA	RTCAH
03200		STA	RTCAC
03300		RTS
     

00100	SETBUF:	LDAI	FBUF	;Read disk into FBUF
00200		STAZ	FLAD	;Setup buffer pointer.
00300		ASLA	;Clear A
00400		STAZ	31	;FLAD+1
00500		LDXI	1	;X=1 For one sector
00600		RTS
00700	
00800	RBUF:	JSR	SETBUF	;Setup address
00900	
01000	;Read sectors from disk.
01100	READ:	JSR	SETTO	;Wait and init time out.
01200		LDAI	143	;IBM read command (n secs)
01300		STA	FDSKC
01400	
01500	RSEC:	LDYI	0
01600	FLOAD:	LDA	DSKSEL	;Check if byte ready
01700		BPL	FLOAD
01800		LDA	FDSKD	;Read byte from disk
01900		STAIY	FLAD
02000		INY
02100		BPL	FLOAD
02200	
02300		LDAZ	FLAD
02400		EORI	200	;Next sector
02500		STAZ	FLAD
02600		BMI	NOPAGE
02700		INCZ	FLAD+1
02800	
02900	NOPAGE:	DEX
03000		BNE	RSEC	;More sectors
03100	
03200		JSR	ENDSK	;Reset disk, timer. Read status
03300		RTS
03400	
03500	ENDSK:	LDAI	57	;End disk op
03600		STA	FDSKC
03700		STX	RTCAC	;Disable timer
03800		TXA	;Wait for >12 cycles.
03900		DEX	;X = 377
04000		TXA
04100		EOR	FDSKC	;Read disk status
04200		ANDI	376	;For busy bit
04300		RTS
     

00100	;Create file routine
00200	ENTR:	STAZ	FLEN	;Save file length.
00300		JSR	LOKUP	;Check if file already exists.
00400		BEQ	FEXIST	;Check if file exists
00500		CMPI	200	;Not in dir. code
00600		BEQ	GBLK
00700	FEXIST:	LDAI	377	;Return with error
00800		RTS
00900	
01000	GBLK:	LDAZ	FFSEC	;Get first free sector
01100		SEC
01200		SBCZ	FLEN	;Check if it fits on track
01300		CMPI	345
01400		BCS	NOBUMP
01500		DECZ	FFTRK
01600		LDAI	376
01700		STAZ	FFSEC
01800	NOBUMP:	LDAZ	FFSEC
01900		STAZ	FSEC
02000		LDAZ	FFTRK
02100		STAZ	FTRK
02200		JSR	SEEK	;Point to new file
02300		BNE	FEXIST	;Verify
02400		LDAI	377	;Set write file open flag.
02500		STAZ	WFOPEN
02600		LDAI	0	;Return with no errors
02700		RTS
     

00100	   LOC ZERO+176000	;SYS Ram
00200	WBUF:	JSR	SETBUF	;Write FBUF
00300	
00400	WRITE:	JSR	SETTO	;Wait and init timer.
00500	
00600		LDAI	103	;Write multiple sectors command
00700		STA	FDSKC
00800	
00900	CLRY:	LDYI	0
01000	WLOOP:	LDA	DSKSEL	;Wait until empty
01100		BPL	WLOOP
01200	
01300		LDAIY	FLAD
01400		STA	FDSKD	;Write chr on disk
01500		INY
01600		BPL	WLOOP
01700	
01800	QW:	LDA	DSKSEL	;Wait for 129th DRQ
01900		BPL	QW
02000		STA	FDSKD
02100	
02200		LDAZ	FLAD
02300		EORI	200	;Next sector
02400		STAZ	FLAD
02500		BMI	CKMOR
02600		INCZ	FLAD+1
02700	CKMOR:	DEX		;More sectors
02800		BNE	CLRY
02900	
03000		JSR	ENDSK	;Reset disk, timer. Read status
03100		BNE	WERR	;Verify if no errors
     

00100	;Verify disk write
00200	VERIFY:	LDAZ	FSEC	;Reset disk sector number
00300		STA	FDSKS
00400		JSR	SETT	;Set timer
00500		LDXZ	NSEC	;Get number of sectors
00600		LDAI	147	;Read MS, HE.
00700		STA	FDSKC
00800	
00900	NXTS:	LDYI	0
01000	VWAI:	LDA	DSKSEL	;Wait for byte
01100		BPL	VWAI
01200		LDA	FDSKD	;Reset DRQ.
01300		INY
01400		BPL	VWAI	;Done with sector
01500	
01600		DEX
01700		BNE	NXTS	;Done with file
01800	
01900		JSR	ENDSK	;Reset disk, timer. Read status
02000	WERR:	RTS	;Return with error bits
     

00100	CLOZE:	BITZ	WFOPEN	;Check if file open
00200		BMI	UPDIR
00300	RERR:	LDAI	377	;Return with error
00400		RTS
00500	
00600	;Update directory
00700	UPDIR:	LDAI	377	;Get end of directory
00800		STAZ	FTRK
00900		LDXZ	SCNT	;Get sec.
01000		INX
01100		TXA
01200		EORI	377	;Invert it
01300		STAZ	FSEC
01400		STAZ	OSEC	
01500		JSR	SEEK
01600		BNE	RERR	;Seek error
01700		JSR	RBUF	;Read end of directory.
01800		BNE	RERR	;Read error
01900	
02000		LDAZ	FFTRK	;Point to new file
02100		STAZ	FTRK
02200		LDAZ	FFSEC
02300		STAZ	FSEC
02400	
02500		LDXZ	FFDIR
02600	
02700	;BLT FBLK into directory
02800		LDYI	0
02900	NAMEIT:	LDAY	FBLK
03000		STAZX	FBUF
03100		INX
03200		INY
03300		CPYI	20	;FBLK Length
03400		BNE	NAMEIT
03500	
03600		LDXZ	OSEC	;Point to end of directory
03700		STXZ	FSEC
03800	
03900		STX	FDSKS
04000		LDXI	1	;For one sector
04100		STXZ	NSEC
04200		JSR	WBUF	;Write new file record
04300		BNE	RERR	;Check for write error
04400	
04500		CLC
04600		LDAZ	FFDIR
04700		ADCI	20	;Update end of dir.
04800		BPL	SVSEC
04900		LDAI	0
05000		INCZ	SCNT	;Next sector
05100	
05200	SVSEC:	STAZ	FFDIR
05300	
05400		LDAZ	FFSEC
05500		SEC
05600		SBCZ	FLEN	;Point to next free sector.
05700		STAZ	FFSEC
05800	
05900		LDAI	375	;Point to header.
06000		STAZ	FSEC
06100		STA	FDSKS	;Start of directory
06200		JSR	RBUF	;Read directory header
06300		BNE	RERR	;Check for read error
06400	
06500		LDXI	1
06600		STXZ	NSEC
06700		LDXI	17	;Header length
06800	HLOOP:	LDAZX	DBUF	;BLT Header into directory
06900		STAZX	FBUF
07000		DEX
07100		BPL	HLOOP
07200	
07300		JSR	WBUF	;Write directory
07400		BNE	RERR	;Write error
07500		STAZ	WFOPEN	;Reset write file open flag
07600	
07700		RTS
     

00100	PIT:	LDYI	0
00200		STAIY	CUR	;Print chr on screen
00300		INCZ	CUR
00400		LDAZ	CUR
00500		ANDI	77
00600		BNE	UPCUR	;Update cursor
00700		DECZ	CUR	;Fix <cr>.
00800		LDAZ	CUR
00900		ANDI	300	;<cr>
01000		STAZ	CUR
01100		JMP	LF	;New line
01200	
01300	BS:	DECZ	CUR	;Back space.
01400	UPCUR:	LDAZ	CUR	;Update cursor
01500		STA	DCURL
01600		LDAZ	CURH
01700		STA	DCURH
01800		RTS
01900	
02000		BLOCK 200	;Zeros
02100	END